home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Taifun
/
Taifun 102 (1989-08-15)(Ossowski, Stefan)(DE)(PD).zip
/
Taifun 102 (1989-08-15)(Ossowski, Stefan)(DE)(PD).adf
/
Life_Research
/
Life in Line 1.3
< prev
next >
Wrap
Text File
|
1989-04-21
|
16KB
|
591 lines
CLEAR ,71000&
SCREEN 1,640,400,2,2
WINDOW 3,,(0,0)-(631,224),16,1
MENU 1,0,1,"about"
MENU 1,1,1," "
MENU 1,2,1," Life in Line Research Program "
MENU 1,3,1," "
MENU 1,4,1," Release 1.3 "
MENU 1,5,1," "
MENU 1,6,1," March 1989 by Rainer Umbach "
MENU 1,7,1," "
ON ERROR GOTO errorhandling
DEFINT a,c,d,f,g,i-l,n-z:DEFDBL b,e,m,h:an=600:am=2000
DIM z(an),m(an),prt(an),mem(am),comm$(am),b$(25),zz(7)
ter=0:rad=2:rgl=20:pmd=0
putitin:
WINDOW 3:CLS
PRINT :PRINT " Life in Line Research Program Release 1.2"
PRINT :INPUT " DISPLAY = 0, CALCULATION = 1, DOC = 2, Stop = 3 : ",wa
IF wa=3 THEN END
IF wa=2 THEN DOC
PRINT :PRINT " ===================================================="
PRINT :PRINT " return to maintain old value"
PRINT " number & return to set new value"
PRINT :PRINT " RAD (old) :"rad
i=0:INPUT " RAD (2-3) : ",i
IF i=2 OR i=3 THEN ter=i-2:rad=i
PRINT :PRINT " do not enter odd rule numbers":PRINT
PRINT " RGL (old) :"rgl
i=0
IF ter THEN
INPUT" RGL (2-254 step 2): ",i
IF i>0 AND i<256 THEN rgl=i
ELSE
INPUT" RGL (2-62 step 2) : ",i
IF i>0 AND i<64 THEN rgl=i
END IF
h=rgl:rgl$=""
FOR n=7 TO 0 STEP -1
zz(n)=0:IF h=>2^n THEN zz(n)=1:h=h-2^n:h$="1":ELSE h$="0"
rgl$=rgl$+h$
NEXT n
PRINT :PRINT " ===================================================="
IF wa=1 THEN turboCALCULATION
IF wa=0 THEN CALCULATIONandDISPLAY
GOTO putitin
errorhandling:
WINDOW 4," *** Error *** *** Error *** *** Error *** *** Error *** ",(50,90)-(581,115),0,1
CLS:PRINT
IF ERR=53 THEN
PRINT " the file you wanted to load doesn´t exist"
ELSE
PRINT " error#"ERR
END IF
WHILE (a$="")
a$=INKEY$
WEND:a$=""
WINDOW CLOSE 4
RESUME putitin
DOC:
OPEN "DOC" FOR INPUT AS #1:cn=0:a$="":CLS
PRINT :PRINT " just a moment ...":PRINT
GOSUB readDOC
WHILE(1)
GOSUB showDOC
GOSUB readDOC
GOSUB nextpage
GOSUB continue
WEND
showDOC:
FOR n=1 TO 25
PRINT b$(n);:b$(n)=""
NEXT n
RETURN
readDOC:
FOR n=1 TO 25
lesen:
IF EOF(1) THEN
CLOSE
GOSUB continue:GOTO putitin
ELSE
c$=INPUT$(1,#1)
b$(n)=b$(n)+c$
IF ASC(c$)=10 THEN weiter
END IF
GOTO lesen
weiter:
NEXT n
RETURN
nextpage:
FOR m=1 TO 3
PALETTE 1,0,0,0
FOR n=1 TO 1000:NEXT n
PALETTE 1,1,1,1
FOR n=1 TO 1000:NEXT n
NEXT m
RETURN
continue:
WHILE (a$="")
a$=INKEY$
WEND:a$=""
RETURN
turboCALCULATION:
CLS:PRINT
a1=ter AND (rgl=88 OR rgl=152)
a2=ter=0 AND (rgl=20)
IF a1 OR a2 THEN
INPUT" recognize pattern to economize output (0 or 1) ";i:PRINT
IF i=1 THEN em=rgl+ter/10:ELSE em=0
IF em<>0 THEN
INPUT " check pattern at generation #",checkit
PRINT:IF checkit<1 THEN GOTO turboCALCULATION
END IF
END IF
INPUT " break off calculation at generation #",breakit
IF em<>0 AND breakit<=checkit THEN turboCALCULATION
IF em=0 AND breakit<1 THEN turboCALCULATION
PRINT :INPUT " check even patterns too (0 or 1): ",i
IF i=1 THEN stp=1:ELSE stp=2
PRINT
INPUT " first MST: ",msta
IF stp=2 THEN IF msta/2=INT(msta/2) THEN msta=msta-1
IF msta<0 THEN msta=1
PRINT:nrmem=0
PRINT " save solutions : s"
PRINT " display solutions : d"
PRINT " restart program : r"
PRINT :csrl=CSRLIN
FOR bit=msta TO msta+10^5 STEP stp
IF nrmem>am THEN sichern
LOCATE csrl,2:PRINT "MST:"bit
bit$="":h=bit:ypos=0
GOSUB DECtoBIN
h=LEN(bit$):h1=INT((an-h)/2):hl=h1:hr=h1+h
IF hlm=0 AND hrm=0 THEN hlm=hr-3:hrm=hl+3
FOR n=hlm TO hrm
z(n)=0:m(n)=0
NEXT n
FOR n=h1 TO h1+h
IF MID$(bit$,(n-h1)+1,1)="1" THEN z(n)=1:hs=1
NEXT n
PRINT " solutions: "nrmem:hl=hl-3:hr=hr+3
Schleife:
IF hs=1 THEN
IF em=152.1 AND ypos=checkit THEN nm=0:GOSUB EM3152:IF nm THEN marke
IF em=88.1 AND ypos=checkit THEN nm=0:GOSUB EM388 :IF nm THEN marke
IF em=20 AND ypos=checkit THEN nm=0:GOSUB EM220 :IF nm THEN marke
IF ypos=breakit THEN ypos=0:nrmem=nrmem+1:mem(nrmem)=bit:GOTO marke
IF ter THEN
FOR n=hl TO hr
m(n)=zz(z(n-3)+z(n-2)+z(n-1)+z(n)+z(n+1)+z(n+2)+z(n+3))
NEXT n
ELSE
FOR n=hl TO hr
m(n)=zz(z(n-2)+z(n-1)+z(n)+z(n+1)+z(n+2))
NEXT n
END IF
hs=0:FOR n=hl-rad TO hr+rad:z(n)=m(n):IF z(n) THEN hs=1
NEXT n:ypos=ypos+1
IF ter THEN
hlh=z(hl+3)+z(hl+2)+z(hl+1)+z(hl)
hrh=z(hr-3)+z(hr-2)+z(hr-1)+z(hr)
IF hlh<>0 AND hl>6 THEN hl=hl-3
IF hrh<>0 AND hr<an-6 THEN hr=hr+3
IF hl<hlm THEN hlm=hl
IF hr>hrm THEN hrm=hr
hlh=hlh+z(hl+4)+z(hl+5)+z(hl+6)
hrh=hrh+z(hr-4)+z(hr-5)+z(hr-6)
IF hlh=0 THEN hl=hl+3
IF hrh=0 THEN hr=hr-3
ELSE
hlh=z(hl+2)+z(hl+1)+z(hl)
hrh=z(hr-2)+z(hr-1)+z(hr)
IF hlh<>0 AND hl>4 THEN hl=hl-2
IF hrh<>0 AND hr<an-4 THEN hr=hr+2
IF hl<hlm THEN hlm=hl
IF hr>hrm THEN hrm=hr
hlh=hlh+z(hl+3)+z(hl+4)
hrh=hrh+z(hr-3)+z(hr-4)
IF hlh=0 THEN hl=hl+2
IF hrh=0 THEN hr=hr-2
END IF
a$=INKEY$:IF a$="s" THEN sichern
IF a$="d" THEN
IF nrmem>0 THEN
lload=1:lnr=0:GOTO gettingMSTsomehow
ELSE
GOTO putitin
END IF
END IF
IF a$="r" THEN putitin
GOTO Schleife
END IF
marke:
NEXT bit
sichern:
OPEN "MST.dat" FOR OUTPUT AS #3
WRITE #3,nrmem
FOR n=1 TO nrmem
WRITE #3,mem(n)
NEXT n
CLOSE
GOTO putitin
CALCULATIONandDISPLAY:
j=0:PRINT:INPUT" if exists load MST.dat file (0 or 1): ",j
lload=0
IF j=1 THEN
lload=1:lnr=0:com=0
OPEN "MST.dat" FOR INPUT AS #3
INPUT #3,nrmem
FOR n=1 TO nrmem
INPUT #3,mem(n)
NEXT n
CLOSE
ELSE
j=0:INPUT " if exists load presentation file (0 or 1): ",j
IF j=1 THEN
nam$=RIGHT$(STR$(rad),LEN(STR$(rad))-1)+"."+RIGHT$(STR$(rgl),LEN(STR$(rgl))-1)
lload=1:lnr=0:com=1
OPEN nam$ FOR INPUT AS #3
INPUT #3,nrmem
FOR n=1 TO nrmem
INPUT #3,mem(n)
INPUT #3,comm$(n)
NEXT
CLOSE
END IF
END IF
CLS
gettingMSTsomehow:
IF lload THEN
lnr=lnr+1:h=mem(lnr):MST=h:IF com THEN lif=198:ELSE lif=206
GOSUB DECtoBIN
ELSE
LOCATE 1,1
PRINT "restart program : * "
PRINT "binary input : ,aba "
PRINT "decimal input : xyz "
PRINT "mutation mode : xyz# "
PRINT "magnify mode : ,aba. or xyz. "
PRINT "casual pattern : <wide> "
IF pmd THEN
PRINT "printer mode off : p "
ELSE
PRINT "printer mode on : p "
END IF
IF eov THEN
PRINT "short Input off : - "
PRINT "MST: "eov$"+"
in$="MST: +"
GOSUB newInput
ELSE
PRINT "short Input on : xyz+ "
in$="MST: "
GOSUB newInput
END IF
h$=LEFT$(bit$,1):i$=RIGHT$(bit$,1):zoom=0:lif=206:csp=0
IF mut THEN FOR n=0 TO an:z(n)=0:m(n)=0:NEXT n:mut=0
IF i$="." THEN zoom=1
IF h$="p" THEN
IF pmd=1 THEN
pmd=0
ELSE
pmd=1
END IF
CLS:GOTO gettingMSTsomehow
END IF
IF h$="*" THEN putitin
IF h$="-" THEN eov=0:CLS:GOTO gettingMSTsomehow
IF i$="#" THEN h=LEN(bit$)-1:bit$=LEFT$(bit$,h):MST=VAL(bit$):mut=1
IF RIGHT$(bit$,1)="+" THEN
eov=1:eov$=LEFT$(bit$,LEN(bit$)-1)
CLS:GOTO gettingMSTsomehow
ELSEIF h$="," THEN
IF zoom THEN bit$=LEFT$(bit$,LEN(bit$)-1)
h=LEN(bit$)-1:bit$=RIGHT$(bit$,h):st=0:MST=0
FOR n=h-1 TO 0 STEP -1
st=st+1:IF MID$(bit$,st,1)="1" THEN MST=MST+2^n
NEXT n
ELSEIF h$="<" THEN
h=LEN(bit$):w=VAL(MID$(bit$,2,h-2)):bit$=""
IF w>500 THEN CLS:GOTO gettingMSTsomehow
FOR n=1 TO w
IF RND*2>1 THEN h$="0":ELSE h$="1"
bit$=bit$+h$
NEXT n:csp=1
ELSE
IF eov THEN bit$=eov$+bit$
h=VAL(bit$):MST=h
GOSUB DECtoBIN
END IF
END IF
h=LEN(bit$):h1=INT((an-h)/2):hl=h1:hr=h1+h
IF hlm=0 AND hrm=0 THEN hlm=hr-3:hrm=hl+3
FOR n=hlm TO hrm
z(n)=0:m(n)=0:prt(n)=0
NEXT n
FOR n=hl TO hr-1
IF MID$(bit$,(n-hl)+1,1)="1" THEN z(n)=1
NEXT n
ypos=0:rsli=0:rsre=0:gen=1:hl=hl-3:hr=hr+3:pyc=7
GOSUB Display
IF zoom THEN
zoom$=""
FOR n=260 TO 339
IF z(n)=1 THEN h$=CHR$(127):hs=1:ELSE h$=" "
zoom$=zoom$+h$
NEXT n
LOCATE 25,1:PRINT zoom$;
ELSE
FOR n=hl TO hr
IF z(n) THEN
PSET (n,ypos)
prt(n)=prt(n)+2^pyc
END IF
NEXT:ypos=1:pyc=pyc-1
END IF
CLOSE
OPEN "par:" FOR OUTPUT AS #6
CYCLEofLIFE:
IF ter THEN
FOR n=hl TO hr
m(n)=zz(z(n-3)+z(n-2)+z(n-1)+z(n)+z(n+1)+z(n+2)+z(n+3))
NEXT n
ELSE
FOR n=hl TO hr
m(n)=zz(z(n-2)+z(n-1)+z(n)+z(n+1)+z(n+2))
NEXT n
END IF
IF mut THEN m(RND*an)=RND*1
hs=0
IF zoom THEN
zoom$="":FOR n=hl-rad TO hr+rad:z(n)=m(n):NEXT
FOR n=260 TO 339
IF z(n)=1 THEN h$=CHR$(127):hs=1:ELSE h$=" "
zoom$=zoom$+h$
NEXT n
SCROLL (0,0)-(640,200),0,-8
LOCATE 25,1:PRINT zoom$;
hlm=257:hrm=353
ELSE
FOR n=hl-rad TO hr+rad
z(n)=m(n)
IF z(n) THEN
PSET(n,ypos):hs=1
prt(n)=prt(n)+2^pyc
END IF
NEXT
pyc=pyc-1
IF pyc=-1 AND pmd=1 THEN
PRINT #6,CHR$(27);"A";CHR$(8)
PRINT #6,CHR$(27);CHR$(42);CHR$(6);CHR$(88);CHR$(2);
FOR npr=1 TO 600
PRINT #6,CHR$(prt(npr));
prt(npr)=0
NEXT npr
END IF
IF pyc=-1 THEN pyc=7
ypos=ypos+1
IF ypos=lif THEN
ypos=ypos-160
SCROLL (0,0)-(640,lif),0,-160
END IF
END IF
gen=gen+1:LOCATE 27,27:PRINT gen
IF hs=0 AND pyc=7 AND pmd=1 THEN
PRINT #6,CHR$(27);CHR$(64)
GOTO Waiting
ELSEIF hs=0 AND pmd=0 THEN
GOTO Waiting
END IF
IF ter THEN
hlh=z(hl+3)+z(hl+2)+z(hl+1)+z(hl)
hrh=z(hr-3)+z(hr-2)+z(hr-1)+z(hr)
IF hlh<>0 AND hl>6 THEN hl=hl-3
IF hrh<>0 AND hr<an-6 THEN hr=hr+3
IF hl<hlm THEN hlm=hl
IF hr>hrm THEN hrm=hr
hlh=hlh+z(hl+4)+z(hl+5)+z(hl+6)
hrh=hrh+z(hr-4)+z(hr-5)+z(hr-6)
IF hlh=0 THEN hl=hl+3
IF hrh=0 THEN hr=hr-3
ELSE
hlh=z(hl+2)+z(hl+1)+z(hl)
hrh=z(hr-2)+z(hr-1)+z(hr)
IF hlh<>0 AND hl>4 THEN hl=hl-2
IF hrh<>0 AND hr<an-4 THEN hr=hr+2
IF hl<hlm THEN hlm=hl
IF hr>hrm THEN hrm=hr
hlh=hlh+z(hl+3)+z(hl+4)
hrh=hrh+z(hr-3)+z(hr-4)
IF hlh=0 THEN hl=hl+2
IF hrh=0 THEN hr=hr-2
END IF
IF ter AND zoom=0 THEN
IF rgl=88 OR rgl=152 THEN
IF gen/20=INT(gen/20) THEN GOSUB BeamCleaner
END IF
END IF
a$=INKEY$:IF a$="" THEN CYCLEofLIFE
IF lload THEN
IF a$="+" THEN
OPEN "MST.dat" FOR OUTPUT AS #3
WRITE #3,(nrmem-lnr)+1
FOR n=lnr TO nrmem
WRITE #3,mem(n)
NEXT n
CLOSE
a$="-"
END IF
IF a$="-" THEN lload=0:lnr=0:nrmem=0
END IF
Waiting:
IF pmd THEN
PRINT #6,CHR$(27);CHR$(64)
CLOSE
END IF
WHILE (a$="")
a$=INKEY$
WEND
IF lnr=nrmem THEN lload=0
a$="":GOTO gettingMSTsomehow
BeamCleaner:
COLOR 2
FOR n=hl TO an:IF z(n)=0 THEN NEXT:ELSE emhl=n:h$=""
FOR n=emhl TO emhl+11
IF z(n)=1 THEN h$=h$+"1":ELSE h$=h$+"0"
NEXT
IF h$="111100110000" THEN
LINE (0,ypos)-(emhl+7,ypos),2
rsli=rsli+1:LOCATE (ypos/8),1:PRINT rsli
FOR n=emhl TO emhl+11:z(n)=0:m(n)=0:NEXT
FOR n=hl TO an:IF z(n)=0 THEN NEXT n:ELSE hl=n-3
END IF
FOR n=hr TO 0 STEP -1:IF z(n)=0 THEN NEXT:ELSE emhr=n:h$=""
FOR n=emhr-11 TO emhr
IF z(n)=1 THEN h$=h$+"1":ELSE h$=h$+"0"
NEXT
IF h$="000011001111" THEN
LINE (emhr-7,ypos)-(600,ypos),2
rsre=rsre+1:LOCATE (ypos/8),71:PRINT rsre
FOR n=emhr-11 TO emhr:z(n)=0:m(n)=0:NEXT
FOR n=hr TO 0 STEP -1:IF z(n)=0 THEN NEXT:ELSE hr=n+3
END IF
COLOR 1
RETURN
Display:
CLS
LOCATE 27,1 :PRINT "RAD: ";rad
LOCATE 27,15:PRINT "Generation: ";gen
LOCATE 28,1 :PRINT "RGL: "rgl
LOCATE 28,15:PRINT "(bin: "rgl$" )"
IF csp=0 THEN
LOCATE 29,1 :PRINT "MST: "MST;
LOCATE 29,15:PRINT "(bin: "bit$" )";
END IF
IF lload AND lnr<=nrmem THEN
IF com THEN
COLOR 3:crsx=(80-LEN(comm$(lnr)))/2
LOCATE 26,crsx:PRINT comm$(lnr):COLOR 1
END IF
LOCATE 27,34:PRINT nrmem-lnr"patterns to go."
LOCATE 28,35:PRINT "break: - , save remaining MST & break: +"
END IF
RETURN
DECtoBIN:
bit$="":hs=0
FOR n=50 TO 0 STEP -1
IF h=>2^n THEN
bit$=bit$+"1":h=h-2^n:hs=1
ELSEIF hs THEN
bit$=bit$+"0"
END IF
NEXT n
RETURN
getMuster:
FOR n=0 TO an:IF z(n)=0 THEN NEXT
emhl=n
FOR n=an TO 0 STEP -1:IF z(n)=0 THEN NEXT
emhr=n:h$=""
FOR n=emhl TO emhr:IF z(n)=1 THEN h$=h$+"1":ELSE h$=h$+"0"
NEXT
RETURN
EM3152:
GOSUB getMuster
IF h$="111" OR h$="11111" OR h$="1100011" THEN nm=1:REM MST 7
IF h$="1111111" OR h$="110010011" THEN nm=1 :REM MST 127
IF h$="11001111" OR h$="11110011" THEN nm=1 :REM MST 207/315
IF h$="11111111" OR h$="1100110011" THEN nm=1 :REM MST 819
RETURN
EM388:
GOSUB getMuster:nmh=0
IF h$="111" OR h$="11111" OR h$="1100011" THEN nm=1:REM MST 7,MST 207/315
IF LEFT$(h$,12)="111100110000" AND RIGHT$(h$,12)="000011001111" THEN nmh=1
IF nmh THEN FOR n=emhl+12 TO emhr-12:IF z(n)=0 THEN NEXT:nm=1
RETURN
EM220:
GOSUB getMuster
IF h$="10010111" OR h$="11101001" THEN nm=1:REM 151
IF h$="10111101" THEN nm=1:REM 189
IF h$="1001111011" OR h$="1101111001" THEN nm=1:REM 635/889
IF h$="10111011" OR h$="101011011" OR h$="1100001011" THEN nm=1
IF h$="111100010011" OR h$="10110110010111" THEN nm=1
IF h$="100010101101001" OR h$="101100000111" THEN nm=1
IF h$="1001100010001" OR h$="1011110001" THEN nm=1
IF h$="11011101" OR h$="110110101" OR h$="1101000011" THEN nm=1
IF h$="110010001111" OR h$="11101001101101" THEN nm=1
IF h$="100101101010001" OR h$="111000001101" THEN nm=1
IF h$="1000100011001" OR h$="1000111101" THEN nm=1:REM 187/221
IF h$="11111000011111" THEN nm=1
IF h$="1010101001010101" THEN nm=1
IF h$="1101011111101011" THEN nm=1
IF h$="110000110011000011" THEN nm=1
IF h$="11110011100111001111" THEN nm=1
IF h$="1011000000000000001101" THEN nm=1
IF h$="1001100000000000011001" THEN nm=1
IF h$="10111000000000011101" THEN nm=1
IF h$="10100100000000100101" THEN nm=1
IF h$="11111000000000011111" THEN nm=1
IF h$="1010101000000001010101" THEN nm=1
IF h$="1101011000000001101011" THEN nm=1
IF h$="110000011000000110000011" THEN nm=1
IF h$="11110001111000011110001111" THEN nm=1
IF h$="1011011101101001011011101101" THEN nm=1
IF h$="1000110110001111000110110001" THEN nm=1
IF h$="111010111101101111010111" THEN nm=1
IF h$="10010001111100111110001001" THEN nm=1
IF h$="110011010100001010110011" THEN nm=1
IF h$="11100100011000011000100111" THEN nm=1
IF h$="1000010011111001111100100001" THEN nm=1
IF h$="1001010000101001" THEN nm=1:REM 15903
RETURN
newInput:
PRINT in$:bit$=""
newInputMarke:
h$=INKEY$
IF h$="" THEN newInputMarke
hh1=1:hh2=1:hh3=1:hh4=1
IF (h$<>"<" AND h$<>">" AND h$<>"," AND h$<>"#") THEN hh1=0
IF (h$<>"*" AND h$<>"-" AND h$<>"+" AND h$<>"." AND h$<>"p") THEN hh2=0
hhh=0
FOR n=0 TO 9
IF ASC(h$)=n+48 THEN hhh=1
NEXT n
IF hhh=0 THEN hh3=0
IF (ASC(h$)<>8 AND ASC(h$)<>13) THEN hh4=0
IF hh1=0 AND hh2=0 AND hh3=0 AND hh4=0 THEN newInputMarke
IF ASC(h$)=13 THEN RETURN
IF ASC(h$)=8 AND bit$<>"" THEN
bit$=LEFT$(bit$,LEN(bit$)-1)
LOCATE CSRLIN-1,7:PRINT bit$" "
ELSEIF ASC(h$)<>8 THEN
bit$=bit$+h$
LOCATE CSRLIN-1,6+LEN(bit$):PRINT h$
END IF
GOTO newInputMarke